perm filename WINGS[GEO,BGB]1 blob
sn#025309 filedate 1973-03-07 generic text, type T, neo UTF8
00100 TITLE WINGS - THE WINGED EDGE SUBROUTINES - JULY 1972.
00200 COMMENT / - MODIFIED FOR GEOMED - 13 JANUARY 1973.
00300
00400 1. BFEV MAKE & KILL OPERATIONS........................4 & 5.
00500 BNEW ← MKB(B); KLB(BNEW);
00600 FNEW ← MKF(B); KLF(B,FNEW);
00700 ENEW ← MKE(B); KLE(B,ENEW);
00800 VNEW ← MKV(B); KLV(B,VNEW);
00900 BNEW ← MKBFV; KLBFEV(Q);
01000
01100 2. WING MAKE LINK OPERATIONS..............................6.
01200 WING(E1,E2);
01300 LINKED(Q1,Q2);
01400
01500 3. ORIENTED WING FETCH & STORE OPERATIONS.............7 & 8.
01600 E ← ELEFT(V,F); E ← ERIGHT(V,F);
01700 E ← ECW(E,Q); E ← ECCW(E,Q);
01800 Q ← OTHER(E,Q); OTHER.(A,E,Q);
01900
02000 4. BFV FETCH OPERATIONS..............................9 & 10.
02100 B ← BODY(Q);
02200 F ← FCW(E,V); F ← FCCW(E,V);
02300 V ← VCW(E,F); V ← VCCW(E,F);
02400 /
02500
02600 INTERN WORLD↔WORLD: 0
02700 INTERN BTOTAL,FTOTAL,ETOTAL,VTOTAL
02800 DECLARE{BTOTAL,FTOTAL,ETOTAL,VTOTAL}
02900 EXTERN KILL,MAKE
00100 SUBR(MKB)---------------------------------------------------------
00200 BEGIN MKB
00300 AOS BTOTAL↔CALL(MAKE,{[BBIT]}) ;CREATE NODE.
00400 DIP 1,1↔DAC 1,1(1)↔DAC 1,2(1)↔DAC 1,3(1) ;FEV - RINGS.
00500 LAC 3,WORLD↔CW 2,3 ;GET WORLD.
00600 CW. 1,3↔CCW. 3,1↔CCW. 1,2↔CW. 2,1 ;WORLD RINGIN.
00700 CDR 1,1↔POP0J ;RETURN BNEW.
00800 BEND;1/14/73------------------------------------------------------
01800
01900 SUBR(KLB)BNEW-----------------------------------------------------
02000 BEGIN KLB
02100 B←1 ↔ X←2 ↔ Y←3
02200 LAC B,ARG1
02300 CW X,B↔CCW Y,B ;DELETE FROM ALBODY RING.
02400 CW. X,Y↔CCW. Y,X
02600 CALL(KILL,B)
02700 SOS BTOTAL↔POP1J
02800 BEND;1/13/73------------------------------------------------------
02900
03000 SUBR(KLBFEV)Q-----------------------------------------------------
03100 BEGIN KLBFEV
03200 ACCUMULATORS{B,F,E,V}
03300 LAC B,ARG1
03400 SETQ(B,{BODY,B})
03500 L1: PFACE F,B↔TESTZ F,FBIT↔GO[CALL KLF,B,F↔GO L1]
03600 L2: PED E,B↔TESTZ E,EBIT↔GO[CALL KLE,B,E↔GO L2]
03700 L3: PVT V,B↔TESTZ V,VBIT↔GO[CALL KLV,B,V↔GO L3]
03800 CALL KLB,B
03900 POP1J
04000 BEND;1/13/73------------------------------------------------------
00100 SUBR(MKF)---------------------------------------------------------
00200 BEGIN MKF
00300 Q←1 ↔ X←2 ↔ B←3
00400 AOS FTOTAL↔CALL(MAKE,{[FBIT]}) ;FACE NODE.
00500 PUSH P,X↔PUSH P,B
00600 LAC B,ARG3↔NFACE X,B↔PFACE. Q,X
00700 NFACE. Q,B↔PFACE. B,Q↔NFACE. X,Q ;RINGIN.
00800 POP P,B↔POP P,X↔POP1J
00900 BEND;1/13/73------------------------------------------------------
01000
01100 SUBR(MKE)---------------------------------------------------------
01200 BEGIN MKE
01300 Q←1 ↔ X←2 ↔ B←3
01400 AOS ETOTAL↔CALL(MAKE,{[EBIT]}) ;EDGE NODE.
01500 PUSH P,X↔PUSH P,B
01600 LAC B,ARG3↔NED X,B↔PED. Q,X
01700 NED. Q,B↔PED. B,Q↔NED. X,Q ;RINGIN.
01800 PBODY. B,Q
01900 POP P,B↔POP P,X↔POP1J
02000 BEND;1/14/73------------------------------------------------------
02100
02200 SUBR(MKV)---------------------------------------------------------
02300 BEGIN MKV
02400 Q←1 ↔ X←2 ↔ B←3
02500 AOS VTOTAL↔CALL(MAKE,{[VBIT]}) ;VERTEX NODE.
02600 PUSH P,X↔PUSH P,B
02700 LAC B,ARG3↔NVT X,B↔PVT. Q,X
02800 NVT. Q,B↔PVT. B,Q↔NVT. X,Q ;RINGIN.
02900 POP P,B↔POP P,X↔POP1J
03000 BEND;1/13/73------------------------------------------------------
00100 SUBR(KLF)B,FNEW --------------------------------------------------
00200 BEGIN KLF
00300 X←2 ↔ Y←B←3
00400 LAC 1,ARG1↔PUSH P,2↔PUSH P,3
00500 NFACE X,1↔PFACE Y,1 ;DELETE FROM FACE RING.
00600 NFACE. X,Y↔PFACE. Y,X
00700 CALL(KILL,1)
00800 SOS FTOTAL ;DECREMENT THE COUNTERS.
00900 POP P,3↔POP P,2↔POP2J
01000 BEND;1/13/73------------------------------------------------------
01100
01200 SUBR(KLE)B,ENEW --------------------------------------------------
01300 BEGIN KLE
01400 X←2 ↔ Y←B←3
01500 LAC 1,ARG1↔PUSH P,2↔PUSH P,3
01600 NED X,1↔PED Y,1 ;DELETE FROM EDGE RING.
01700 NED. X,Y↔PED. Y,X
01800 CALL KILL,1
01900 SOS ETOTAL ;DECREMENT THE COUNTERS.
02000 POP P,3↔POP P,2↔POP2J
02100 POP2J
02200 BEND;1/13/73------------------------------------------------------
02300
02400 SUBR(KLV)B,VNEW --------------------------------------------------
02500 BEGIN KLV
02600 X←2 ↔ Y←B←3
02700 LAC 1,ARG1↔PUSH P,2↔PUSH P,3
02800 NVT X,1↔PVT Y,1 ;DELETE FROM VERTEX RING.
02900 NVT. X,Y↔PVT. Y,X
03000 CALL(KILL,1)
03100 SOS VTOTAL ;DECREMENT THE COUNTERS.
03200 POP P,3↔POP P,2↔POP2J
03300 BEND;1/13/73------------------------------------------------------
00100 SUBR(WING)E1,E2---------------------------------------------------
00200 BEGIN WING;PLACE WING POINTERS BETWEEN TWO EDGES.
00300 ;THE AC-0 CONTROL BITS:
00400 ;[0-NV2-NV1] [0-PV2-PV1] [0-NF2-NF1] [0-PF2-PF1].
00500 E1←3 ↔ E2←4
00600 SAVAC(4)↔SETZ↔CDR E1,ARG2↔CDR E2,ARG1
00700
00800 ;FIND THE COMMON VERTEX.
00900 ;AC-1 ← (NV1,,PV1) ⊗ (NV2,,PV2) NN,,PP IN COMMON.
01000 ;AC-2 ← (PV1,,NV1) ⊗ (NV2,,PV2) PN,,NP IN COMMON.
01100 LAC 1,3(E1)↔MOVS 2,1↔XOR 1,3(E2)↔XOR 2,3(E2)
01200 TLNN 1,-1↔TRO 3000↔TRNN 1,-1↔TRO 0300
01300 TLNN 2,-1↔TRO 2100↔TRNN 2,-1↔TRO 1200
01400
01500 ;FIND THE COMMON FACE.
01600 LAC 1,1(E1)↔MOVS 2,1↔XOR 1,1(E2)↔XOR 2,1(E2)
01700 TLNN 1,-1↔TRO 0030↔TRNN 1,-1↔TRO 0003
01800 TLNN 2,-1↔TRO 0021↔TRNN 2,-1↔TRO 0012
01900
02000 ;STORE THE WINGS AS INDICATED.
02100 SETCA
02200 TRNN 2020↔NCW. E1,E2↔TRNN 1010↔NCW. E2,E1
02300 TRNN 2002↔PCCW. E1,E2↔TRNN 1001↔PCCW. E2,E1
02400 TRNN 0220↔NCCW. E1,E2↔TRNN 0110↔NCCW. E2,E1
02500 TRNN 0202↔PCW. E1,E2↔TRNN 0101↔PCW. E2,E1
02600 GETAC(4)↔POP2J
02700 BEND;1/13/73------------------------------------------------------
00100 SUBR(LINKED)Q1,Q2 ------------------------------------------------
00200 BEGIN LINKED; DETERMINE WHETHER TWO FEV ENTITIES ARE LINKED.
00300 ACCUMULATORS{Q1,Q2,E}
00400 CDR Q1,ARG2↔CDR Q2,ARG1
00500
00600 ;BRANCH ON THE COMBINATION OF ARGUMENT TYPES.
00700 LDB 0,[POINT 3,(Q1),16]↔LDB 1,[POINT 3,(Q2),16]
00800 CAMLE 0,1↔EXCH Q1,Q2
00900 IOR 1,0↔GO@[FALSE↔FF↔EE↔FE↔VV↔FV↔EV↔FALSE](1)
01000
01100 ;FACES WITH COMMON EDGE.
01200 FF: PED E,Q1↔DAC E,E0#
01300 CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
01400 SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO FF+2↔GO FALSE
01500
01600 ;EDGE IN FACE PERIMETER.
01700 FE: PFACE 1,Q2↔CAMN 1,Q1↔GO TRUE
01800 NFACE 1,Q2↔CAMN 1,Q1↔GO TRUE↔GO FALSE
01900
02000 ;VERTEX IN FACE PERIMETER.
02100 FV: PED E,Q2↔DAC E,E0
02200 JUMPE E,[PFACE 1,Q1↔PVT 0,Q2↔CAME 0,1↔GO FALSE↔GO TRUE]
02300 PFACE 1,E↔CAMN 1,Q1↔GO TRUE↔NFACE 1,E↔CAMN 1,Q1↔GO TRUE
02400 SETQ(E,{ECCW,E,Q2})↔CAME E,E0↔GO FV+2↔GO FALSE
02500
02600 ;EDGES WITH A COMMON VERTEX.
02700 EE: PVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
02800 NVT 1,Q2↔CAMN 0,1↔GO TRUE
02900 NVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
03000 NVT 1,Q2↔CAMN 0,1↔GO TRUE↔GO FALSE
03100
03200 ;VERTEX IN EDGE.
03300 EV: PVT 1,Q1↔CAMN 1,Q2↔GO TRUE
03400 NVT 1,Q1↔CAMN 1,Q2↔GO TRUE↔GO FALSE
03500
03600 ;VERTICES WITH A COMMON EDGE.
03700 VV: PED E,Q1↔DAC E,E0
03800 CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
03900 SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO VV+2↔GO FALSE
04000
04100 FALSE: SETZ 1,↔POP2J
04200 TRUE: SETO 1,↔POP2J
04300 LIT↔VAR
04400 BEND;1/13/73------------------------------------------------------
00100 INTERN ERIGHT,ELEFT-----------------------------------------------
00200 ERIGHT: TDZA 1,1 ;E ← ERIGHT(FROM-V,ABOUT-F).
00300 ELEFT: SETO 1, ;E ← ELEFT(FROM-V,ABOUT-F).
00400 BEGIN EFETCH
00500 ACCUMULATORS{V,F,E1,E2}
00600 Q←←1
00700 SAVAC(5)
00800 DAC Q,QFLAG#↔LAC V,ARG2↔LAC F,ARG1
00900 TEST V,VBIT↔GO[SETCMM QFLAG↔EXCH F,V↔GO .+1]
01000 PED E2,V↔DAC E2,E0#
01100 L1: LAC E1,E2
01200
01300 ;E2←ECW(E1,V) AND Q←FCW(E1,V).
01400 PVT Q,E1↔CAME Q,V↔GO .+4
01500 NCCW E2,E1↔NFACE Q,E1↔GO .+6
01600 NVT Q,E1↔CAME Q,V↔GO[FATAL(EFETCH1)]
01700 PCCW E2,E1↔PFACE Q,E1
01800 CAMN Q,F↔GO L2
01900 CAME E2,E0↔GO L1
02000 FATAL(EFETCH2)
02100 L2: LAC 1,E1↔SKIPE QFLAG↔LAC 1,E2
02200 GETAC(5)↔POP2J
02300 COMMENT . V EDGE FETCH MANDALA
02400 / \
02500 / \
02600 / \
02700 ELEFT F ERIGHT
02800 / \
02900 / \ .
03000 BEND;1/13/73------------------------------------------------------
00100 ;E←ECW(FROM-X,ABOUT-Y) - EDGE CLOCKWISE FROM X ABOUT Y.
00200 SUBR(ECW)---------------------------------------------------------
00300 BEGIN ECW
00400 Q←1 ↔ X←2 ↔ E←3
00500 CDR 1,ARG2↔TEST 1,EBIT↔GO ERIGHT
00600 DAC 2,AC2↔ DAC 3,AC3
00700 CDR X,ARG1↔LAC E,1
00800 TEST X,VBIT↔GO[
00900 PFACE Q,E↔CAME Q,X↔GO L1↔ PCW Q,E↔GO L
01000 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L]
01100 PVT Q,E↔CAME Q,X↔GO L2↔ NCCW Q,E↔GO L
01200 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ PCCW Q,E↔GO L
01300 DIE: FATAL(ECW)
01400 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
01500 LIT
01600 BEND;1/13/73------------------------------------------------------
01700
01800 SUBR(ECCW)--------------------------------------------------------
01900 BEGIN ECCW
02000 Q←1 ↔ X←2 ↔ E←3
02100 CDR 1,ARG2↔TEST 1,EBIT↔GO ELEFT
02200 DAC 2,AC2↔ DAC 3,AC3
02300 CDR X,ARG1↔LAC E,1
02400 TEST X,VBIT↔GO[
02500 PFACE Q,E↔CAME Q,X↔GO L1↔ PCCW Q,E↔GO L
02600 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCCW Q,E↔GO L]
02700 PVT Q,E↔CAME Q,X↔GO L2↔ PCW Q,E↔GO L
02800 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L
02900 DIE: FATAL(ECCW)
03000 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
03100 LIT
03200 BEND;1/13/73------------------------------------------------------
00100 SUBR(OTHER)E,Q----------------------------------------------------
00200 BEGIN OTHER
00300 Q←←1↔X←←2↔E←←3
00400 DAC 2,AC2↔DAC 3,AC3
00500 CDR X,ARG1↔CDR E,ARG2
00600 TEST X,FBIT↔GO L1
00700
00800 ;OTHER FACE OF THE EDGE.
00900 PFACE Q,E↔CAME Q,X↔GO .+3↔NFACE Q,E↔GO .+5
01000 NFACE Q,E↔CAME Q,X↔GO[FATAL({OTHER FACE})]
01100 PFACE Q,E↔LAC 2,AC2↔LAC 3,AC3↔POP2J
01200
01300 ;OTHER VERTEX OF THE EDGE.
01400 L1: PVT Q,E↔CAME Q,X↔GO .+3↔NVT Q,E↔GO .+5
01500 NVT Q,E↔CAME Q,X↔GO[FATAL({OTHER VERTEX})]
01600 PVT Q,E↔LAC 2,AC2↔LAC 3,AC3↔POP2J
01700 LIT
01800 BEND;1/13/73------------------------------------------------------
01900
02000 SUBR(OTHER.)Q,E,X-------------------------------------------------
02100 BEGIN OTHER.
02200 Q←←1↔X←←2↔E←←3
02300 DAC 2,AC2↔DAC 3,AC3
02400 CDR X,ARG1↔CDR E,ARG2↔CDR Q,ARG3
02500 TEST X,VBIT↔GO[
02600 PFACE 0,E↔CAME 0,X↔GO L1↔NFACE. Q,E↔GO L
02700 L1: NFACE 0,E↔CAME 0,X↔GO DIE↔PFACE. Q,E↔GO L]
02800 NVT 0,E↔CAME 0,X↔GO L2↔PVT. Q,E↔GO L
02900 L2: PVT 0,E↔CAME 0,X↔GO DIE↔NVT. Q,E↔GO L
03000 DIE: FATAL(OTHER.)
03100 L: LAC 2,AC2↔LAC 3,AC3
03200 POP3J↔LIT
03300 BEND;1/13/73------------------------------------------------------
00100 ; BODY FETCHER - GET THE BODY OF Q.
00200 ; B ← BODY(Q).
00300 SUBR(BODY)--------------------------------------------------------
00400 BEGIN BODY
00500 Q←1
00600 CDR Q,ARG1
00700 TESTZ Q,BBIT
00800 POP1J ;Q'S ALREADY A BODY.
00900 TESTZ Q,EBIT
01000 L1: GO [PBODY Q,Q↔POP1J] ;Q WAS AN EDGE.
01100 TESTZ Q,FBIT
01200 GO [PFACE 0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;FACE
01300 TESTZ Q,VBIT
01400 GO [PVT 0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;VERTEX
01500 POP1J; Q AIN'T GOT NO BODY.
01600 L2: LAC 1,0↔POP1J ;VERTEX BODY CASE.
01700 LIT
01800 BEND;1/13/73------------------------------------------------------
01900
00100 SUBR(BDET)B ------------------------------------------------------
00200 BEGIN BDET; BODY DETACH - BGB - 17 FEBRUARY 1973.
00300 LAC 1,ARG1↔TEST 1,BBIT↔POP1J
00400 BRO 2,1↔SIS 3,1
00500 BRO. 2,3↔SIS. 3,2 ;RINGO.
00600 CAMN 2,1↔SETZ 2,
00700 DAD 3,1↔SON 0,3
00800 CAMN 0,1↔SON. 2,3 ;DAD OUT.
00900 SETZ↔DAD. 0,1
01000 BRO. 0,1↔SIS. 0,1 ;CLEAR SELF.
01100 POP1J
01200 BEND;2/17/73------------------------------------------------------
01300
01400 SUBR(BATT)B1,B2 --------------------------------------------------
01500 BEGIN BATT; BODY ATTACH B1 TO B2 - BGB - 17 FEBRUARY 1973.
01600 LAC 1,ARG2↔TEST 1,BBIT↔POP2J↔DAD 0,1
01700 JUMPN[CALL(BDET,1)↔GO .+1] ;MAKE B1 AN ORPHAN.
01800 LAC 2,ARG1↔TEST 2,BBIT↔POP2J
01900 DAD. 2,1 ;B2 IS B1'S NEW DADDY.
02000 SON 3,2↔JUMPE 3,[SON. 1,2
02100 BRO. 1,1↔SIS. 1,1↔POP2J] ;FIRST CHILD CASE.
02200 BRO 2,3
02300 BRO. 2,1↔SIS. 1,2 ;MANY CHILD CASE.
02400 SIS. 3,1↔BRO. 1,3
02500 POP2J
02600 BEND;2/17/73------------------------------------------------------
00100 ;V ← VCW(E,F).
00200 SUBR(VCW)---------------------------------------------------------
00300 BEGIN VCW
00400 Q←1↔E←2
00500 DAC 2,AC2↔CDR E,ARG2
00600 PFACE Q,E↔CAME Q,ARG1↔GO .+3↔PVT Q,E↔GO L
00700 NFACE Q,E↔CAME Q,ARG1↔GO[FATAL(VCW)]↔NVT Q,E
00800 L: LAC 2,AC2↔POP2J↔LIT
00900 BEND;1/13/73------------------------------------------------------
01000
01100 ;V ← VCCW(E,F).
01200 SUBR(VCCW)--------------------------------------------------------
01300 BEGIN VCCW
01400 Q←1↔E←2
01500 DAC 2,AC2↔CDR E,ARG2
01600 PFACE Q,E↔CAME Q,ARG1↔GO .+3↔NVT Q,E↔GO L
01700 NFACE Q,E↔CAME Q,ARG1↔GO[FATAL(VCCW)]↔PVT Q,E
01800 L: LAC 2,AC2↔POP2J↔LIT
01900 BEND;1/13/73------------------------------------------------------
02000
02100 ;F ← FCW(E,V).
02200 SUBR(FCW)---------------------------------------------------------
02300 BEGIN FCW
02400 Q←1↔E←2
02500 DAC 2,AC2↔CDR E,ARG2
02600 PVT Q,E↔CAME Q,ARG1↔GO .+3↔NFACE Q,E↔GO L
02700 NVT Q,E↔CAME Q,ARG1↔GO[FATAL(FCW)]↔PFACE Q,E
02800 L: LAC 2,AC2↔POP2J↔LIT
02900 BEND;1/13/73------------------------------------------------------
03000
03100 ;F ← FCCW(E,V).
03200 SUBR(FCCW)--------------------------------------------------------
03300 BEGIN FCCW
03400 Q←1↔E←2
03500 DAC 2,AC2↔CDR E,ARG2
03600 PVT Q,E↔CAME Q,ARG1↔GO .+3↔PFACE Q,E↔GO L
03700 NVT Q,E↔CAME Q,ARG1↔GO[FATAL(FCCW)]↔NFACE Q,E
03800 L: LAC 2,AC2↔POP2J↔LIT
03900 BEND;1/13/73------------------------------------------------------
00100 SUBR(MKLOCOR)-----------------------------------------------------
00200 BEGIN MKLOCOR
00300 CALL(MAKE,[1.0])
00400 SLACI(<1.0>)
00500 DAC IX(1)
00600 DAC JY(1)
00700 DAC KZ(1)
00800 POP0J
00900 BEND;1/13/73------------------------------------------------------
01000 END
01100 WING.FAI - EOF.